home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor1 / hider.src < prev    next >
Text File  |  1991-06-12  |  3KB  |  123 lines
  1. %%HP: T(3)A(D)F(.);
  2. @ HIDER, by Marc E Blair
  3. DIR
  4.   NORMAL
  5.     \<<
  6.       IF PATH { HOME } \=/
  7.       THEN NULL PURGE
  8.       END
  9.     \>>
  10.   HIDE
  11.     \<<
  12.       IF DUP TYPE 6 ==
  13.       THEN 1 \->LIST
  14.       END \-> L
  15.       \<< VARS L SIZE 1 SWAP
  16.         FOR A L A GET DELIT
  17.         NEXT
  18.         IF PATH { HOME } \=/
  19.         THEN PATH NULL STO NULL 1 \->LIST + ORDER
  20.         ELSE DROP "NOT ALLOWED AT HOME" DOERR
  21.         END
  22.       \>>
  23.     \>>
  24.   ALL
  25.     \<< VARS DUP SIZE NULL RCL \-> S A
  26.       \<< NULL
  27.         IFERR PURGE
  28.         THEN DROP
  29.         ELSE A NULL RCL
  30.           IF SAME NOT
  31.           THEN VARS A NULL STO SWAP 
  32.             IFERR ORDER
  33.             THEN DROP
  34.             END DUP 1 S SUB SWAP DUP SIZE S 1 + SWAP SUB NULL SWAP + +
  35.           END
  36.         END
  37.       \>>
  38.     \>>
  39.   HIDEN
  40.     \<< ALL DUP DUP NULL POS
  41.       IF DUP 0 \=/
  42.       THEN 1 + SWAP SIZE SUB
  43.         IFERR NULL RCL DROP
  44.         THEN DROP { }
  45.         ELSE
  46.           IF PATH { HOME } \=/
  47.           THEN NULL SWAP +
  48.           ELSE DROP { }
  49.           END
  50.         END
  51.       ELSE 3 DROPN { }
  52.       END
  53.     \>>
  54.   NULL
  55.     \<< # 15777h SYSEVAL
  56.     \>>
  57.   SPACE
  58.     \<< " " # 5B15h SYSEVAL
  59.     \>>
  60.   DELIT
  61.     \<< OVER SIZE \-> S
  62.       \<< DUP2 POS \-> A
  63.         \<<
  64.           IF A 0 \=/
  65.           THEN
  66.             IF S 1 ==
  67.             THEN DROP2 { }
  68.             ELSE
  69.               IF A 1 ==
  70.               THEN SWAP 2 S SUB SWAP DROP
  71.               ELSE
  72.                 IF A S ==
  73.                 THEN SWAP 1 S 1 - SUB SWAP DROP
  74.                 ELSE SWAP DUP 1 A 1 - SUB SWAP A 1 + S SUB + SWAP DROP
  75.                 END
  76.               END
  77.             END
  78.           ELSE DROP
  79.           END
  80.         \>>
  81.       \>>
  82.     \>>
  83.   KEYSTO
  84.     \<< { S
  85.       \<<
  86.         IFERR { } SWAP DUP
  87.           IF TYPE 5 ==
  88.           THEN DUP SIZE
  89.           ELSE 1 \->LIST 1
  90.           END 1 SWAP
  91.           FOR A DUP A GET RCL
  92.             IF TYPE 15 ==
  93.             THEN
  94.               IF DUP A GET RCL BYTES SWAP DROP 6.5 ==
  95.               THEN 1
  96.               ELSE 0
  97.               END
  98.             ELSE 1
  99.             END
  100.             IF
  101.             THEN DUP A GET PURGE
  102.             ELSE DUP A GET ROT SWAP + SWAP
  103.             END
  104.           NEXT DROP
  105.           IF DUP { } \=/
  106.           THEN \->STR "\010Non-empty directory" + DOERR
  107.           ELSE DROP
  108.           END
  109.         THEN
  110.           IF { } ==
  111.           THEN "Too Few Arguments"
  112.           ELSE DROP2 "Not Purgeable"
  113.           END DOERR
  114.         END
  115.       \>> 54.2
  116.       \<<
  117.         IF PATH { HOME } \=/
  118.         THEN # 15777h SYSEVAL PURGE
  119.         END VARS "HIT PURGE" 1 DISP 1 FREEZE
  120.       \>> 54.3 } STOKEYS
  121.     \>>
  122. END
  123.